home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-11
/
colorset.zip
/
COLORSET.PRG
< prev
next >
Wrap
Text File
|
1993-01-04
|
21KB
|
847 lines
* COLORSET.PRE
*
* GENERIC PROCEDURE allows user to interactively change colors.
*
* Michael K. Bozovich
* 12-20-1989 <Panama Invasion Day>
*
* This procedure requires linking with IDL.LIB and EXTEND.LIB in
* addition to the standard CLIPPER.LIB.
*
* Global Color Variables:
*
* c_scr_color - 'Normal Text' - used by most everything...
* c_err_color - 'Error Messages'
* c_msg_color - 'Status Messages'
* c_int_color - 'Screen Titles / High Intensity'
* c_inv_color - 'Input Fields / Inverse Video / GETs'
* c_hlp_color - 'Help Screen Colors'
*
* Programmer imposed limitations:
*
* 1. Foreground and background colors may NOT match.
* This combination is totally disallowed and may not
* even be chosen by accident.
*
* 2. The screen title color must have the same background
* as the normal text color.
*
* 3. The "enhanced" color for normal text is ALWAYS the
* "standard" color for input fields and vice versa.
*
*
* Save current DOS screen attribute for clearing screen upon exit.
*
save_attr = GET_ATTR()
*
* Define screen colors based on graphics card detected.
*
IF ! FILE("colors.mem")
IF VID_TYPE() > 0
c_scr_color = "15/1,1/3" && Overall Screen colors
c_err_color = "15/4" && Error Messages
c_msg_color = "15/2" && Status Messages
c_int_color = "14/1" && High Intensity
c_inv_color = "1/3,3/1" && Inverse Video
c_hlp_color = "10/0" && Help Screen(s)
ELSE
c_scr_color = "7/0,0/7" && Complimentary MONO colors...
c_err_color = "0/15"
c_msg_color = "0/7"
c_int_color = "15/0"
c_inv_color = "0/7,7/0"
c_hlp_color = "0/7"
ENDIF
SAVE TO colors.mem ALL LIKE c_*
ENDIF
RESTORE FROM colors.mem ADDITIVE
SET COLOR TO (c_scr_color)
SET CURSOR OFF
CLEAR SCREEN
*
* This 'hidden' color variable is only used only for hiding the simulated
* wait state READ in COLORSEL below.
*
* It can be derived from the current screen colors. Here is the algorithm...
*
hidden = LTRIM(STR(INT(GET_ATTR() / 16), 0))
hidden = hidden + "/" + hidden + "," + hidden + "/" + hidden
*
* Define these variables to be 'global'. They are used by COLORSEL and
* must be returned successfully in order to build the modified color strings.
*
STORE 0 TO _attr_, fore, back
*
* Draw a sample screen 'Title'
*
DO Title
*
* Draw the color sample box.
*
@ 6, 41 TO 10, 69 DOUBLE
_str_row_ = (10 - 6) / 2 + 6
*
* This next routine draws the rectangle of all possible colors that the user
* may choose from and saves the screen to a mem file.
*
* The outer (i) FOR loop cycles through the possible
* BACKGROUND colors.
*
* The inner (j) FOR loop cycles through the possible
* FOREGROUND colors.
*
* The supplemental counter (k) is used for cursor
* positioning so that there is even spacing between the attribute numbers.
*
* THIS IS UNACCEPTABLY SLOW, EVEN ON A 12-Mhz AT !!!
*
* Try the following:
*
* 1. Use Clipper SET COLOR TO instead of APRINT(). - Just as slow.
* 2. Draw the stupid thing in "hidden color" and use - Just as slow.
* the SET_ATTR() function to splash on the color.
* 3. Save/Restore screen from a memvar. - Very acceptable.
*
* The solution is, of course, to only draw the fucker if necessary, save it
* to a memvar file, and pop it on the screen every other time.
*
IF ! FILE("attrib.mem")
FOR i = 0 TO 7
k = 0
FOR j = 0 TO 15
@ i + 13, j + (9 - 2) + k SAY ;
APRINT(" " + STRZERO(j + i * 16, 3) + " ", j + i * 16)
k = k + 3
NEXT j
NEXT i
attr_screen = SAVESCREEN(13, 9 - 2, ;
13 + 7, 9 + 60 + 2)
SAVE TO attrib.mem ALL LIKE attr_screen*
ENDIF
*
* Restore from the screen memfile and pop up the screen.
*
RESTORE FROM attrib.mem ADDITIVE
RESTSCREEN(13, 9 - 2, ;
13 + 7, 9 + 60 + 2, attr_screen)
*
* Set up for ACHOICE()...
*
PRIVATE options[7]
options[1] = "1 - Normal Screen Text"
options[2] = "2 - Screen Titles"
options[3] = "3 - Input Fields"
options[4] = "4 - Status Messages"
options[5] = "5 - Error Messages"
options[6] = "6 - Help Screens"
options[7] = "7 - Save Selections"
@ 2, 9 TO 10, 34 DOUBLE
choice = 1
DO WHILE .t.
* SET KLUDGE ON
KEYBOARD CHR(1) && Keep the silly thing 'synchronized' ......
* SET KLUDGE OFF
ACHOICE(2 + 1, 9 + 2, 10 - 1, 34 - 2, ;
options, .t., "showstat", choice)
IF LASTKEY() == 27
EXIT
ENDIF
ENDDO
CLS(save_attr)
SET CURSOR ON
******************************************************************************
******************************************************************************
******************************************************************************
FUNCTION SHOWSTAT
*
* This function is called from the ACHOICE() function with each keypress.
*
* It's main purpose is to keep the sample window screen region updated
* with the color for the currently highlited choice.
*
* If the <Enter> key is pressed, the actual COLORSEL routine is called
* and the user can play...
*
* If the <Esc> key is pressed, the value indicating 'abort' is returned
* and ACHOICE() exits.
*
* Note the kludge allowing wrap around within ACHOICE()...
*
PARAMETERS mode, index, win_pos
*
* This little kludge stores the current attribute of the menu hilite so we
* can KEEP it hilited while in the keystroke exception, even though ACHOICE
* normally does not.
*
SET COLOR TO (c_inv_color)
item_atr = FOREGROUND() + BACKGROUND() * 16
SET COLOR TO (c_scr_color)
* SET FUN ON
*
* Calculate a suitable 'dim' attribute so we can dim the menu while in
* COLORSEL...
*
dim_attr = IF(FOREGROUND() == 7, 8, 7) + BACKGROUND() * 16
* SET FUN OFF
*
* Update the sample window...
*
IF index == 1 && Normal
SET COLOR TO (c_scr_color)
_str_ = "NORMAL TEXT"
ELSEIF index == 2 && Title
SET COLOR TO (c_int_color)
_str_ = "SCREEN TITLE"
ELSEIF index == 3 && Inverse
SET COLOR TO (c_inv_color)
_str_ = "INPUT FIELD"
ELSEIF index == 4 && Messages
SET COLOR TO (c_msg_color)
_str_ = "STATUS MESSAGE"
ELSEIF index == 5 && Error Messages
SET COLOR TO (c_err_color)
_str_ = "ERROR MESSAGE"
ELSEIF index == 6 && Help Screens
SET COLOR TO (c_hlp_color)
_str_ = "HELP SCREEN"
ELSEIF index == 7 && Save (Normal)
SET COLOR TO (c_scr_color)
_str_ = "<UNDEFINED>"
ENDIF
_str_col_ = (69 - 41 - LEN(_str_)) / 2 + 41
@ _str_row_, 41 + 1 SAY SPACE(69 - 41 - 1)
*
* With the proper color turned on, say the nifty little message in the
* sample window so we can tell what it is from GET_ATTR() below...
*
@ _str_row_, _str_col_ SAY _str_
*
* Some of the sample box is left with the "normal text" color value.
* Fill in the rest of it with this IDL command. How handy!
*
SET_ATTR(GET_ATTR(_str_row_,_str_col_),6,41,10,69)
*
* Turn 'normal' color back on...
*
SET COLOR TO (c_scr_color)
IF (mode == 1 .AND. LASTKEY() == 5) .OR. ; && Allows 'wrap'
(mode == 2 .AND. LASTKEY() == 24)
* SET KLUDGE ON
choice = IF(mode == 1, 7, 1)
RETURN 1
* SET KLUDGE OFF
ELSEIF mode == 3
*
* A key was pressed, we need to determine if it was one of our
* two 'special' keys.
*
IF LASTKEY() == 13
*
* Dim the pick list region to indicate that it is not active.
* Also 're-highlite' the selected record because ACHOICE() clears
* the highlite when the record is selected.
*
SET_ATTR(dim_attr, 2, 9, 10, 34)
SET_ATTR(item_atr, 2 + index, 9 + 2, ;
2 + index, 34 - 2)
*
* If we are not 'saving',
* Do the color selection routine and let the user play...
*
IF index # 7
DO COLORSEL
ENDIF
*
* For each case below, a new global variable must be constructed.
*
* Depending on the variable updated, portion(s) of the screen may
* need to be 'refreshed'...
*
* If it was the overall 'normal text' color that was altered, a
* little extra work needs to be done. Likewise with the 'input field'
* colors. (Inverse video) Otherwise, the construction is straightforward
* as demonstrated below...
*
IF index == 1 && Normal
*
* Since the normal and inverse strings are mutually interdependent,
* if one was altered, so must the other be. i.e. ............
*
c_scr_color = fore + "/" + back + "," + SUBSTR(c_inv_color, 1, AT(",", c_inv_color) - 1)
c_inv_color = SUBSTR(c_inv_color, 1, AT(",", c_inv_color) - 1) + "," + fore + "/" + back
*
* Since the 'title screen' colors are also used for 'high intensity'
* in others places through the system, I am restricting the background
* to be the same as the 'normal text' background. The user just
* changed the 'normal text', so the 'title screen' variable must
* also be....
*
c_int_color = SUBSTR(c_int_color, 1, AT("/", c_int_color)) + back
*
* The 'hidden' color variable is only used only for hiding the simulated
* wait state READ below.
*
* It needs to be re-generated from the 'normal text' variable
* each time it is changed. Here is the algorithm...
*
hidden = back + "/" + back + "," + back + "/" + back
*
* IDL to the rescue!
* To avoid redrawing the screen to reflect the new overall
* text colors, just 'splash it on'..... :)
*
SET_ATTR(_attr_, 0, 0, 24, 79)
*
* Since we just wiped out the color selection rectangle, pop it back...
*
RESTSCREEN(13, 9 - 2, ;
13 + 7, 9 + 60 + 2, attr_screen)
*
* ...re-draw the title...
*
DO Title
*
* ...'re-dim' the menu...
*
SET COLOR TO (c_scr_color)
dim_attr = IF(FOREGROUND() == 7, 8, 7) + BACKGROUND() * 16
SET_ATTR(dim_attr, 2, 9, 10, 34)
*
* ...and 're-hilite' the current menu item. <Whew!>
*
SET COLOR TO (c_inv_color)
item_atr = FOREGROUND() + BACKGROUND() * 16
SET_ATTR(item_atr, 2 + index, 9 + 2, ;
2 + index, 34 - 2)
*
* Better tell Clipper about the global color change now...
*
SET COLOR TO (c_scr_color)
ELSEIF index == 2 && Title
c_int_color = fore + "/" + back
DO Title
ELSEIF index == 3 && Inverse
*
* Since the normal and inverse strings are mutually interdependent,
* if one was altered, so must the other be. i.e. ............
*
c_inv_color = fore + "/" + back + "," + SUBSTR(c_scr_color, 1, AT(",", c_scr_color) - 1)
c_scr_color = SUBSTR(c_scr_color, 1, AT(",", c_scr_color) - 1) + "," + fore + "/" + back
*
* We changed the 'inverse' color, so we have to redraw the
* current item on the menu...
*
SET COLOR TO (c_inv_color)
item_atr = FOREGROUND() + BACKGROUND() * 16
SET COLOR TO (c_scr_color)
SET_ATTR(item_atr, 2 + index, 9 + 2, ;
2 + index, 34 - 2)
ELSEIF index == 4 && Messages
c_msg_color = fore + "/" + back
ELSEIF index == 5 && Error Messages
c_err_color = fore + "/" + back
ELSEIF index == 6 && Help Screens
c_hlp_color = fore + "/" + back
ELSEIF index == 7 && Save
SAVE TO colors.mem ALL LIKE c_*
ENDIF
*
* Wipe off the silly looking arrows... :-)
*
@ 13 - 1 , 0
@ 13 + 7 + 1, 0
FOR i = 13 TO 13 + 7
@ i, 9 + 60 + 4 SAY SPACE(1)
@ i, 9 - 4 SAY SPACE(1)
NEXT i
*
* 'Undim' the pick list region.
*
SET_ATTR(GET_ATTR(), 2, 9, 10, 34)
ELSEIF LASTKEY() == 27
*
* Let ACHOICE() know we are done with it.
*
RETURN 0
ENDIF
ENDIF
*
* Return value indicating 'continue'. This is returned if no keystroke
* exception interesting to us ocurred OR <Enter> was pressed.
*
RETURN 2
******************************************************************************
******************************************************************************
******************************************************************************
PROCEDURE COLORSEL
*
* Determine the ~CURRENT~ IDL attribute value of the color set chosen.
*
* This value is used to calculate foreground and background values for
* Clipper color strings AND to calculate row & column positions for the
* pointers. It must be available to the NAVIGATE PROCEDURE...
*
_attr_ = GET_ATTR(_str_row_, _str_col_)
*
* Calculate the Clipper numerical values of the foreground and background
* colors based on the IDL attribute value. These variables must be
* available to the SET KEY "navigation" procedure below.
*
fore = _attr_ % 16
back = INT(_attr_ / 16)
*
* Calculate the current row and column positions for the arrow pointers
* based on the current attributes and print them there. These two
* variables must also be available to the SET KEY procedure below.
*
fore_col = (fore * 4) + 9
back_row = back + 13
*
* The color is reset here to the ORIGINAL "normal text" colors in order
* to print usage messages and arrow pointers.
*
SET COLOR TO (c_scr_color)
@ 23, INT((80 - LEN("Use the arrow keys to select a color combination")) / 2) SAY ;
"Use the arrow keys to select a color combination"
@ 24, INT((80 - LEN("Press <Enter> to select, <Esc> to abort")) / 2) SAY ;
"Press <Enter> to select, <Esc> to abort"
@ 13 - 1 , fore_col SAY CHR(25)
@ 13 + 7 + 1, fore_col SAY CHR(24)
@ back_row , 9 + 60 + 4 SAY CHR(27)
@ back_row , 9 - 4 SAY CHR(26)
*
* Activate the SET KEY procedure so that the user can move the nifty
* little arrows around and watch the pretty colors change right before
* their eyes.... :)
*
SET KEY 4 TO NAVIGATE
SET KEY 19 TO NAVIGATE
SET KEY 5 TO NAVIGATE
SET KEY 24 TO NAVIGATE
* SET KLUDGE ON
*
* All the action takes place in this CONTRIVED WAIT STATE while the SET KEY
* procedure is activated. See notes in the procedure below.
*
* If Nantucket would allow INKEY() as a wait state... <sigh>
*
KEYBOARD CHR(0)
INKEY()
dummy = " "
SET COLOR TO (hidden)
SET INTENSITY OFF
@ 0, 78 GET dummy VALID (LASTKEY() == 13 .OR. LASTKEY() == 27)
READ
SET INTENSITY ON
SET COLOR TO (c_scr_color)
@ 0, 78 SAY SPACE(1)
@ 23, 0 SAY SPACE(80)
@ 24, 0 SAY SPACE(80)
RELEASE dummy
* SET KLUDGE OFF
*
* OK, fun's over! Deactivate the hot keys so that the menu will work.
*
SET KEY 4 TO
SET KEY 19 TO
SET KEY 5 TO
SET KEY 24 TO
IF LASTKEY() == 13
*
* Eureka!
*
* A new color was chosen while in the wait state. Let's re-read the
* attribute from the sample window.
*
_attr_ = GET_ATTR(6, 41)
ENDIF
*
* User ~MAY~ have pressed ESC ...
* Just in case, re-draw the color of the sample window...
*
SET_ATTR(_attr_, 6, 41, 10, 69)
*
* Need need to re-calculate new foreground and background attribute values.
* This time, they need to be converted to STRINGS so Clipper can use them!
*
* Note: These will NOT have changed if the user pressed ESC!
*
fore = LTRIM(STR(_attr_ % 16, 0))
back = LTRIM(STR(INT(_attr_ / 16), 0))
******************************************************************************
******************************************************************************
******************************************************************************
PROCEDURE NAVIGATE
*
* This SET KEY procedure moves the attribute pointers up/down/left/right
* to select foreground & background colors.
*
* 'Wrap around' is supported. As the arrow pointers move, the sample
* window background color is updated to reflect the current pointer
* positions.
*
PARAMETERS a, b, c
*
* Deactivate the hot-keys so this procedure may not call itself via hot-key.
*
SET KEY 5 TO
SET KEY 24 TO
SET KEY 19 TO
SET KEY 4 TO
*
* User is attempting to change the background attribute of 'high-intensity'.
*
* TOUGH SHIT! Re-activate the hot-keys and return.
*
IF index == 2 .AND. (LASTKEY() == 5 .OR. LASTKEY() == 24)
*# SNAP XREF OFF
SET KEY 5 TO NAVIGATE
SET KEY 24 TO NAVIGATE
SET KEY 19 TO NAVIGATE
SET KEY 4 TO NAVIGATE
*# SNAP XREF ON
RETURN
ENDIF
*
* The color was changed to hide the READ. Change it back to normal.
*
SET COLOR TO (c_scr_color)
*
* Clear the screen positions where the arrows are CURRENTLY located.
*
IF LASTKEY() == 5 .OR. LASTKEY() == 24
@ back_row, 9 + 60 + 4 SAY SPACE(1)
@ back_row, 9 - 4 SAY SPACE(1)
ELSE
@ 13 - 1, fore_col SAY SPACE(1)
@ 13 + 7 + 1, fore_col SAY SPACE(1)
ENDIF
DO WHILE .t.
IF LASTKEY() == 4
*
* Increment the pointer column by four. (move right)
*
fore_col = fore_col + 4
*
* If we have reached the end, go to the start. (wrap around)
*
IF fore_col > 9 + 60
fore_col = 9
ENDIF
ELSEIF LASTKEY() == 19
*
* Decrement the pointer column by four. (move left)
*
fore_col = fore_col - 4
*
* If we have reached the start, go to the end. (wrap around)
*
IF fore_col < 9
fore_col = 9 + 60
ENDIF
ELSEIF LASTKEY() == 5
*
* Decrement the row variable. (go up)
*
back_row = back_row - 1
*
* If we have reached the top, go to the bottom. (wrap around)
*
IF back_row < 13
back_row = 13 + 7
ENDIF
ELSE
*
* Increment the row variable. (go down)
*
back_row = back_row + 1
*
* If we have reached the bottom, go to the top. (wrap around)
*
IF back_row > 13 + 7
back_row = 13
ENDIF
ENDIF
*
* Re-calculate the attribute values based on the new pointer positions.
*
fore = (fore_col - 9) / 4
back = back_row - 13
*
* If foreground # background, we're OK. Exit the loop.
* Otherwise, move to the next pointer position.
*
IF fore # back
EXIT
ENDIF
ENDDO
*
* Display the pointer arrows in their new positions.
*
IF LASTKEY() == 5 .OR. LASTKEY() == 24
@ back_row, 9 + 60 + 4 SAY CHR(27)
@ back_row, 9 - 4 SAY CHR(26)
ELSE
@ 13 - 1 , fore_col SAY CHR(25)
@ 13 + 7 + 1, fore_col SAY CHR(24)
ENDIF
*
* Update the sample window to reflect current pointer position color.
*
SET_ATTR(fore + back * 16, 6, 41, 10, 69)
*
* Re-Activate the hot keys just prior to returning.
*
*# SNAP XREF OFF
SET KEY 5 TO NAVIGATE
SET KEY 24 TO NAVIGATE
SET KEY 19 TO NAVIGATE
SET KEY 4 TO NAVIGATE
*# SNAP XREF ON
*
* Change color back to hidden.
*
SET COLOR TO (hidden)
******************************************************************************
******************************************************************************
******************************************************************************
PROCEDURE Title
SET COLOR TO (c_int_color)
@ 3, (80 - 34 - LEN(EXPAND("CHANGE COLOR"))) / 2 + 34 SAY EXPAND("CHANGE COLOR")
SET COLOR TO (c_scr_color)
* eof colorset.pre